The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/gravity.src

Text File | 1991-10-19 | 13KB | 361 lines

%%HP: T(3)A(R)F(.);
@ GRAVITY GAME by David F. Kurth  06Jun91  Ver 1.0
@
@ Original Concept Stolen From Some Ancient HP Desktop Calculator
@
@ Object:  Launch a missile from your station (a cross or X
@ on the left side of the screen) to hit a target (a bull's-eye
@ on the right side of the screen).  Two to five planets affect
@ the missile's path due to their gravitational field.  Larger
@ diameter planets have more influence.
@
@ Controls: Your only input is the firing angle of your missile.
@ An angle of 0 degrees shoots horizontal to the right.  90 degrees
@ is straight up.  If there is too much planet mass behind your
@ station, you may not be able to reach the target.  On the other
@ hand, an indirect missile path may have surprising results.
@ Be careful, or you may hit yourself!  Your station and the target
@ have no gravity, so they will not "attract" the missile.
@
@ Caution: This game is realtime.  One must realize that when using
@ convention missiles without warp drive travelling way below the
@ speed of light, it takes time to cover such astronomical distances.
@ This game is ideal for long boring meetings where you have time
@ to burn and want everyone to think you're still solving those
@ complicated problems that *required* the purchase of your calculator
@ in the first place.
@
@ Starting: Download the program to the calculator.  This is in
@ straight ASCII format, so there is no need to mess with ASC->
@ binary, uuencode, or any other format.  Then push the GRAV menu key
@ to start the program.
@
@ For a simple demo, enter "2" for a seed and 10 degrees for the angle.
@ This direct shot takes about 30 seconds.
@ For a crazy demo, enter "2" for a seed and 20 degrees for the angle.
@ Now wait about 7 minutes and see what a different path the missile
@ follows to hit the target.  When the missile is travelling, any
@ keystroke (other than ATTN/ON) will abort the current shot.  You
@ may abort because you think your shot will miss.  If you let the
@ missile continue though, you may find the missile will go around
@ again and eventually hit the target.  This is what makes the game
@ fun to watch and predict.
@
@ This is presented with no rights reserved.  I take no responsibility
@ for any damage or injury to anyone caused by this program.  I
@ believe the physics are correct, but then again all the constants
@ are made up to fit the "universe" on the screen.
@ I'm no expert on the HP48 (I've only had one since Feb).  I only
@ wish things would go faster.  If you find a way to speed things up,
@ please post the info so I and everyone else may be enlightened.
@ Above all, have fun and maybe you'll learn something new.
@
@ Directory
@ Checksum # CDEEh
@ Bytes      4654
@ Checksum will change after program is run due to creation of variables
@
@
DIR
  GRAV
    \<< RCLF \-> f           @ Save status
      \<< 2 CF INIT 2 SF     @ Set up variables
        WHILE 2 FS?          @ Start main loop
        REPEAT
          SENDMIS
        END
        f STOF               @ Restore status
      \>>
      { GRAV } ORDER 2 MENU  @ Restore VAR menu with GRAV first
      KILL                   @ Remove HALT annuciator.
    \>>
  INIT
    \<< GETSEED ERASE { #0d #0d} PVIEW
      5 'MAX.PL' STO       @ Max Number of Planets
      4 'T.SIZE' STO       @ Target Size radius
      3 'S.SIZE' STO       @ Station Size radius
      10 'MAX.MIS' STO     @ Max Number of Missles
      10 'MNUM' STO        @ Missle Number of Current Shot
      5 'TIME.MAG' STO     @ Time Magnification when off-screen
      1E-3 'MIN.FORC' STO  @ Minumum Force to determine Missile lost
      12 'VINIT' STO       @ Initial Missle Velocity
      360 'Gk' STO         @ Gravitational Konstant
      0 'ANGLE' STO        @ Initial Missle Velocity Angle
      0.2 'DTIME' STO      @ Delta Time
      { } 'POSITION' STO   @ Position/Mass Array, Station, Target, + Planets
      MAX.PL 1 - RAND * IP 2 + 'NUM.P' STO  @ Random number of Planets (2-5)
      GENSTAT
      GENTARG
      GENPLAN
      ANGLE SETMIS @ Set missile data in case user doesn't first time
    \>>
  GETSEED  @ Set random number seed
    \<<
      "Enter random seed or\010"
      "Nothing if don't care\010" +
      "Push ENTER" +
      ""
      INPUT DUP SIZE
      IF 0 \=/
      THEN
        OBJ\-> RDZ @ If number entered, set seed
      ELSE
        DROP       @ Else clear stack
      END
    \>>
  GENTARG  @ Locate and draw target in right half of screen
    \<<
      POSITION
      24 RAND * IP 87 +   @ X value
      24 RAND * IP 20 +   @ Y value
      T.SIZE              @ Mass (radius) value
      3 \->LIST 1 \->LIST + 'POSITION' STO
      DTARG
    \>>
  DTARG  @ Draw target
    \<<
      PICT POSITION 2 GET OBJ\-> DROP2 SWAP 4 - R\->B
      SWAP 4 - R\->B 2 \->LIST TARG REPL
    \>>
  GENSTAT  @ Locate and draw station in left half of screen
    \<<
      POSITION
      24 RAND * IP 20 +   @ X value
      24 RAND * IP 20 +   @ Y value
      S.SIZE              @ Mass (radius) value
      3 \->LIST 1 \->LIST + 'POSITION' STO
      DSTAT
    \>>
  DSTAT  @ Draw station
    \<<
      PICT POSITION 1 GET OBJ\-> DROP2 SWAP 3 - R\->B
      SWAP 3 - R\->B 2 \->LIST STAT REPL
    \>>
  GENPLAN  @ Locate and draw planets with separation
    \<< 3 0 0 \-> i x y
      \<<
        DO
          POSITION
          110 RAND * IP 10 + DUP R\->B 'x' STO  @ X value
          40 RAND * IP 10 + DUP R\->B 'y' STO   @ Y value
          x y 2 \->LIST DUP 'x' STO PIXON       @ Show location temporarily
          5 RAND * IP 2 +                       @ Mass value
          3 \->LIST 1 \->LIST + 'POSITION' STO
          1 CF
          1 i 1 -
          FOR j
            i j CALDIFF
            IF 12 <
            THEN 1 SF
            END
          NEXT
          x PIXOFF
          IF 1 FC?
          THEN      @ Location is valid, draw planet
            i DPLAN 1 'i' STO+
          ELSE      @ Invalid location, remove from list
            POSITION DUP SIZE 1 - 1 SWAP SUB 'POSITION' STO
          END
        UNTIL i NUM.P 2 + >
        END
      \>>
    \>>
  DPLAN  @ Draw one planet
    \<<
      POSITION SWAP GET OBJ\-> DROP R\->B 3 ROLLD
      R\->B SWAP R\->B SWAP 2 \->LIST SWAP
      0 6.28 RAD ARC
    \>>
  CALDIFF  @ Calculate distance between surface of planets i & j
    \<< \-> i j
      \<<  @ DIFF = SQRT((Yj-Yi)^2 + (Xj-Xi)^2) - Mj - Mi
        POSITION j GET OBJ\-> DROP POSITION i GET OBJ\-> DROP
        4 ROLL + 5 ROLLD SWAP 3 ROLLD - DUP * 3 ROLLD - DUP *
        + \v/ SWAP -
      \>>
    \>>
  REDRAW  @ Draw station, target, and planets again
    \<<
      ERASE { #0d #0d } PVIEW DSTAT DTARG
      3 NUM.P 2 +
      FOR j
        j DPLAN
      NEXT
    \>>
  SENDMIS  @ Send a missile
    \<<
      3 CF            @ Outside Station Flag (clear for inside)
      0 'HitSom' STO  @ 0 = hit nothing
                      @ 1 = hit planet
                      @ 2 = hit target
                      @ 3 = hit station
                      @ 4 = lost in space
                      @ 5 = user aborted missile
                      @ 6 = quit program
      IF MNUM 0 ==
      THEN 2 CF       @ Out missles, quit
      ELSE
        TEXT CLLCD    @ Activate and clear text screen
        {
          { "VIEW" \<< { #0d #0d} PVIEW WAITK DHELP \>> }
          { "REDR" \<< REDRAW DHELP \>> }
          { "SHOT" \<< TEXT CLLCD ""
                     IF MNUM MAX.MIS \=/
                     THEN
                       "Last Angle was " +
                       2 FIX ANGLE \->STR + "\010" +
                     END
                     "Input angle, push CONT" +
                     "    90"   3 DISP
                     "180 ** 0" 4 DISP
                     "   -90"   5 DISP
                     3 FREEZE
                     PROMPT
                     DUP 'ANGLE' STO SETMIS DHELP \>> }
          { "CONT" CONT }
          { "GO" CONT }
          { "QUIT" \<< 2 CF 6 'HitSom' STO CONT \>> }
        }
        TMENU DHELP                  @ Display menu and help text
        HALT
        MNUM 1 - 'MNUM' STO          @ One less missile now
        { #0d #0d } PVIEW
        WHILE HitSom NOT             @ Until we hit something
        REPEAT UPDATE DRAWXY EVALPOS @ Calculate missle movement
        END
      END
    \>>
  SETMIS  @ Set initial values for missile data, angle is on stack
    \<<
      NEG DUP DEG COS VINIT * 'VX' STO SIN
      VINIT * 'VY' STO POSITION 1 GET OBJ\-> DROP2 'YM' STO
      'XM' STO
    \>>
  DHELP  @ Display help for temporary menu
    \<<
      TEXT CLLCD
      "VIEW - See Planets"     1 DISP
      "REDR - Redraw Screen"   2 DISP
      "SHOT - Enter Angle"     3 DISP
      "GO   - Launch Missile"  4 DISP
      "QUIT - Restore and End" 5 DISP
      MNUM STD \->STR " Missle" +
      IF MNUM 1 \=/ THEN "s" + END " Left" + 7 DISP
      3 FREEZE
    \>>
  UPDATE  @ Update missile position and velocity
    \<< 0 0 \-> fx fy
      \<<
        IF XM DUP 0 < SWAP 130 > OR
           YM DUP 0 < SWAP  63 > OR OR  @ If off screen
        THEN TIME.MAG DTIME *           @ increase time interval
        ELSE DTIME
        END 'T' STO
        3 NUM.P 2 +
        FOR i                           @ For each planet
          i CALDIST \-> x y m d         @ Cal dist to missle
          \<<
            y YM - m * Gk * d DUP DUP * * DUP 3 ROLLD /
            'fy' STO+
            x XM - m * Gk * SWAP /
            'fx' STO+                   @ Sum resulting forces
          \>>
        NEXT
        fx T * 'VX' STO+ fy T * 'VY' STO+  @ From total force
        VX T * 'XM' STO+ VY T * 'YM' STO+  @ Find new velocity
        fx DUP * fy DUP * + 'FORCE' STO    @ and missile location
      \>>
    \>>
  CALDIST  @ Calculate distance from missile to center of planet
    \<<
      POSITION SWAP GET DUP OBJ\-> DROP2 YM - DUP * SWAP XM - DUP * + \v/
      SWAP OBJ\-> DROP 4 ROLL   @ Return X, Y, Mass, Distance
    \>>
  DRAWXY  @ Draw pixel on screen for missile position
    \<<
      XM R\->B YM R\->B 2 \->LIST PIXON
    \>>
  EVALPOS  @ Evaluate missile position
    \<<
      IF KEY                      @ If a key is hit, abort missile
      THEN
        5 'HitSom' STO
      ELSE
        IF DTIME TIME.MAG * T ==  @ If off screen
        THEN
          IF FORCE MIN.FORC <   @ Check if lost in space
          THEN 4 'HitSom' STO
          END
        ELSE                    @ Else when on screen
          3 NUM.P 2 +           @ Check if we hit a planet
          FOR i
            i CALDIST \-> x y m d
            \<<
              IF d m \<= THEN 1 'HitSom' STO END
            \>>
          NEXT
          1 CALDIST             @ Check if we hit the station
          IF 3 FC?              @ IF not outside station
          THEN
            IF S.SIZE 1 + >     @ Are we outside yet?
            THEN 3 SF           @ We are now outside the station
            END
          ELSE                  @ We are outside
            IF S.SIZE 1 + \<=   @ did we hit ourself?
            THEN 3 'HitSom' STO
            END
          END
          2 CALDIST             @ Check if we hit the target
          IF T.SIZE 1 + \<= THEN 2 'HitSom' STO END
        END
      END
      CLEAR                     @ Clear CALDIST stuff off stack
      MESS                      @ Output appropriate message
    \>>
  MESS  @ Display appropriate message
    \<<
      IF HitSom
      THEN
        TEXT CLLCD              @ Display text screen and clear
        CASE
          HitSom 1 ==
          THEN "Hit Planet"
          END
          HitSom 2 ==
          THEN "You Hit the Target\010Using "
            MAX.MIS MNUM - STD \->STR +
            " Missile" +
            IF MAX.MIS MNUM - 1 \=/
            THEN "s" +
            END
            2 CF              @ Stop program
          END
          HitSom 3 ==
          THEN
            "You Blew Yourself Up"
            2 CF              @ Stop program
          END
          HitSom 4 ==
          THEN "Missle Escaped System"
          END
          HitSom 5 ==
          THEN "Missle Aborted"
          END
        END
        1 DISP
        IF MNUM 0 ==
        THEN
          "Game Over No Missiles" 3 DISP
        END
        "  Push any key EXCEPT"   4 DISP
        "  ATTN/ON to continue"   5 DISP WAITK
      END
    \>>
  WAITK  @ Wait for any key press
    \<<
      0 WAIT DROP
    \>>
  STAT GROB 7 7 C141F755F741C1                        @ Station cross
  TARG GROB 9 9 8300EF006C00BB10BA10BB106C00EF008300  @ Target bullseye
END